perm filename MEM[G,BGB]4 blob
sn#053589 filedate 1973-07-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE MEM MEMORY MANAGEMENT ROUTINES.
C00005 00003 SUBR(MKCAMERA)
C00007 00004 SUBR(MKWORLD) MAKE A WORLD NODE.
C00009 00005 SUBR(MORCOR) Get more core *
C00011 00006 SUBRS MKNODE,KLNODE Make and Kill nodes *
C00013 00007 SUBR COMPACT
C00018 00008 SUBR RELOCATE,OFFSET
C00020 ENDMK
C⊗;
TITLE MEM ;MEMORY MANAGEMENT ROUTINES.
INTERN OLD44,UNIVER,BLKCNT,AVAIL,INVALID
EXTERN REL
OLD44: 0 ;ORIGINAL JOBREL 44 CONTENTS.
UNIVER: 0 ;POINTER TO UNIVERSE NODE.
BLKCNT: 0 ;NUMBER OF NON EMPTY NODES.
AVAIL: 0 ;POINTER TO FIRST EMPTY NODE.
REMAINDER:0 ;NUMBER OF UNUSED WORDS BETWEEN
; THE TOP OF NODE SPACE AND THE TOP OF CORE.
INVALID:0 ;SET DURING SHRINK
NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
MINLINK←←-3 ;LOWEST NUMBERED LINK
TYPMASK←←17 ;MASK TO EXTRACT TYPE INFORMATION
SUBR(MKUNIV) ;MAKE UNIVERSE.
COMMENT ⊗------------------------------------------------------------
⊗
ACCUMULATORS{U,WNDO,WRLD,CAM}
SETQ(TMP1#,{MKWORLD})
SETQ(TMP2#,{MKWINDOW})
SETQ(CAM,{MKCAMERA})
LAC WRLD,TMP1
LAC WNDO,TMP2
LAC U,UNIVER
DAD. WRLD,U↔SON. WRLD,U ;NOW WORLD & PRIME WORLD.
CW. WNDO,U↔CCW. WNDO,U ;NOW DISPLAY & PRIME DISPLAY.
BRO. CAM,CAM↔SIS. CAM,CAM ;CAMERA RING.
BRO. WRLD,WRLD↔SIS. WRLD,WRLD ;WORLD RING.
BRO. WNDO,WNDO↔SIS. WNDO,WNDO ;WINDOW RING.
CW. WNDO,WNDO↔CCW. WNDO,WNDO ;DISPLAY RING.
DAD. CAM,WNDO↔SON. CAM,WNDO ;NOW CAMERA & PRIME CAMERA OF A WINDOW.
DAD. CAM,WRLD↔SON. CAM,WRLD ;NOW CAMERA & PRIME CAMERA OF A WORLD.
SON. WRLD,CAM ;CAMERA BELONGS TO A WORLD.
POP0J
ENDR MKUNIV;7/12/73(BGB)---------------------------------------------
SUBR(MKCAMERA)
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(CAMERA#,{MKNODE,[PBIT+$CAMERA]})
;DEFAULT PHYSICAL RASTER SIZE.
DEFINE MM{3.2808E-3}
LAC[0.1739109E-1]↔DAC 1(1) ;PDX.
LAC[0.1314883E-1]↔DAC 2(1) ;PDY.
LAC[0.4101E-1]↔DAC 3(1) ;FOCAL
;DEFAULT LOCIGAL RASTER SIZE.
LACI =144↔DAP 1(1) ;LDX
LACI =108↔DAP 2(1) ;LDY
LACI =100000↔DAP 3(1) ;LDZ
LAC[-339.57]↔DAC -3(1) ;SCALEX
LAC[-336.84]↔DAC -2(1) ;SCALEY
LAC[4101.00]↔DAC -1(1) ;SCALEZ
;CAMERA LOCUS AND ORIENTATION.
CALL(MKFRAME↑)
LAC[16.0]↔DAC ZWC(1) ;16 FEET ABOVE XY PLANE.
LAC 2,CAMERA↔FRAME. 1,2
; CALL(BATT,CAMERA,UNIVERSE)
LAC 1,CAMERA
POP0J
ENDR MKCAMERA;3/12/73(BGB)-------------------------------------------
SUBR(MKWORLD) ;MAKE A WORLD NODE.
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(WORLD#,{MKNODE,[PBIT+$WORLD]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
CALL(MKFRAME↑) ;WORLD FRAME OF REFERENCE.
LAC 2,WORLD
FRAME. 1,2
; CALL(BATT,WORLD,UNIVERSE) ;PLACE WORLD IN UNIVERSE.
LAC 1,WORLD
POP0J
ENDR MKWORLD;3/12/73(BGB)--------------------------------------------
SUBR(MKWINDOW) ;MAKE A WINDOW NODE.
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(WINDOW#,{MKNODE,[PBIT+$WINDOW]})
LAC[3.5]↔DAC -1(1) ;MAG
LAC[XWD -=511,=511]↔DAC 1(1) ;XWD XL,,XH
LAC[XWD -=384,=384]↔DAC 2(1) ;XWD YL,,YH
; CALL(BATT,WINDOW,UNIVERSE)
LAC 1,WINDOW
POP0J
ENDR MKWINDOW;3/12/73(BGB)-------------------------------------------
SUBR(MORCOR) ;Get more core *
COMMENT ⊗------------------------------------------------------------
⊗
;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
SKIPE OLD44↔GO L1 ;SKIP ON FIRST TIME ONLY.
LAC 1,44↔DAC 1,OLD44 ;SAVE JOBREL.
ADDI 1,1↔ ;SETUP UNIVERSE NODE.
ADDI 1,1↔DAC 1,AVAIL
ADDI 1,1↔DAC 1,BLKCNT
ADDI 1,1↔DAC 1,UNIVERSE
SETZM REMAINDER
;FOUR MORE K.
L1: LAC 1,44↔LAC 0,1↔ADDI 0,10000
CALLI 11↔FATAL<NO MORE CORE.>
AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
LACI 2↔DAP @UNIVERSE
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ,0]
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ]
AOS@BLKCNT↔GO .+1]
DAPZ 1,@AVAIL
L2: HLRZM 1,(1)↔AOS 3(1) ;EMPTY LINK & EMPTY TYPE-1.
ADD 1,[XWD NODSIZ,NODSIZ]
CAILE 2,NODSIZ+NODSIZ-1(1)
GO L2↔AOS 3(1)
SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
LACI 10000↔LAC 1,UNIVER↔ADDM -3(1) ;CORE SIZE.
LAC 1,@AVAIL
LAC 2,AC2↔POP0J
ENDR MORCOR;4-DEC-72(BGB)
;SUBRS MKNODE,KLNODE ;Make and Kill nodes *
;____________________________________________________________________
SUBR(MKNODE,NODTYP) ;ALLOCATE A BLOCK OF NODSIZ WORDS. *
SKIPN 1,@AVAIL↔CALL(MORCOR) ;GET AN EMPTY NODE.
CDR(1)↔DAP @AVAIL
SETZM(1)↔AOS @BLKCNT↔ADDI 1,3
POP P,RETADR# ;SAVE RETURN ADDRESS.
POP P,(1) ;PLACE NODE TYPE INTO NODE.
GO @RETADR ;RETURN.
ENDR MKNODE;4-DEC-72(BGB)
;____________________________________________________________________
SUBR(KLNODE,NODE) ;RELEASE BLOCK OF NODSIZ WORDS.
LAC 1,NODE↔LAC (1)
CAIN 0,1↔GO [ FATAL(KILLING EMPTY NODE.)]
SOS @BLKCNT
LIPI -3(1)↔LAPI -2(1) ;CLEAR NODE.
SETZM -3(1)↔BLT 8(1)
AOS(1) ;MARK NODE TYPE EMPTY-1.
SUBI 1,3↔LAC@AVAIL ;CONS NODE TO AVAIL LIST.
DAPZ(1)↔DAPZ 1,@AVAIL
POP1J
ENDR KLNODE;4-DEC-72(BGB)
SUBR COMPACT
COMMENT ⊗____________________________________________________________
Note: to change to handle non-contiguous blocks of node space,
rewrite the following macro to know about block boundaries. ⊗
DEFINE NXTNOD(AC,LIMIT)
<ADDI AC,NODSIZ↔CAML AC,LIMIT>
ACCUMULATORS{P1,NODE,HOLE,ONE}
;Pass 1: Locate free nodes below BREAK and LAC nodes in use above
;break into free nodes, leaving pointer in its place to new node
;location.
LAC NODE,@BLKCNT ;CALCULATE ADDRESS OF BREAK
IMULI NODE,NODSIZ
ADD NODE,UNIVERSE
DAC NODE,BREAK
SUBI NODE,NODSIZ ;INCREMENTED AT HLOOP
MOVEI ONE,$EMPTY ;FOR A FAST TYPE CHECK
SKIPA HOLE,UNIVERSE
;HOLES LOOP.
HLOOP: NXTNOD HOLE,BREAK ;FIND A HOLE BELOW BREAK
GO UPDATE ;BREAK FOUND, NOW UP POINTS
CAME ONE,(HOLE) ;IS IT AN EMPTY NODE?
GO HLOOP
;NODES LOOP.
NLOOP: NXTNOD NODE,44 ;FIND A NODE ABOVE BREAK
GO [ WARNING<NODE COUNT TOO BIG> ;HIT TOP END!
GO UPDATE ]
CAMN ONE,(NODE) ;IS IT AN EMPTY NODE?
GO NLOOP ;NO, TRY NEXT
HRLZI 0,MINLINK(NODE) ;YES, COPY NODE INTO HOLE BELOW
HRRI 0,MINLINK(HOLE)
BLT 0,NODSIZ+MINLINK-1(HOLE)
HRRZM HOLE,(NODE) ;MAKE POINTER FROM OLD TO NEW LOCATION
SETOM INVALID
GO HLOOP
;Pass two: Go thru all of node space and check for pointers between
;BREAK and top of node space and change them to point to new
;location below BREAK.
PTYPE←HOLE
UPDATE: SKIPN INVALID
POPJ P,
LAC NODE,UNIVERS
ULOOP: LAC PTYPE,(NODE)
TLNE PTYPE,400400 ;FRAME CHEAT
SETZ PTYPE,
ANDI PTYPE,TYPMASK
HLLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HLLZ 0,YREL(NODE)
LSH 0,6
MOVEI P1,NODSIZ+MINLINK-1(NODE)
LLOOP: JUMPE 0,DORIGHT
JUMPL 0,[CAR 1,(P1)
CAMGE 1,BREAK
GO .+1
CAMLE 1,44
GO [ WARNING<INVALID POINTER FOUND>
GO .+1 ]
LAC 1,(1)
DIP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,LLOOP
DORIGH: HRLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HRLZ 0,YREL(NODE)
LSH 0,6
MOVEI P1,NODSIZ+MINLINK-1(NODE)
RLOOP: JUMPE 0,DONEXT
JUMPL 0,[CDR 1,(P1)
CAMGE 1,BREAK
GO .+1
CAMLE 1,44
GO [ WARNING<INVALID POINTER FOUND>
GO .+1 ]
LAC 1,(1)
DAP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,RLOOP
DONEXT: NXTNOD NODE,BREAK
GO .+2
GO ULOOP
;We're done, now shrink core size and make a new AVAIL list.
;(This may need to be rewritten for non-contiguous node space)
DONE: LAC HOLE,BREAK
MOVEI 0,MINLINK(HOLE)
CORE 0,
FATAL<Can't shrink core!>
HRRZI 1,MINLINK+1(HOLE)
CAMN 1,44 ;CHECK THE OBSCURE CASE
GO [ SETZB 0,2 ;YES, RIGHT ON THE CORE BOUNDARY
GO NOFREE ] ;MKNODE WILL GET MORE WHEN IT NEEDS IT
HRLI 1,MINLINK(HOLE) ;ZERO FREE AREA
SETZM MINLINK(HOLE)
LAC 2,44 ;LEAVE TOP IN 2 FOR FAST COMPARES
BLT 1,(2)
SETZ 0,
; SUBI HOLE,NODSIZ
MKLOOP: CAIGE 2,NODSIZ+MINLINK-1(HOLE) ;IS IT IN CORE?
GO AVLFIN
DAC ONE,(HOLE) ;SET TYPE BITS
HRRZM 0,MINLINK(HOLE) ;LINK TO PREVIOUS FREE NODE
MOVEI 0,MINLINK(HOLE) ;THIS FREE NODE
ADDI HOLE,NODSIZ
GO MKLOOP
AVLFIN: SUBI 2,MINLINK(HOLE) ;AMOUNT OF SPACE LEFT
NOFREE: DAC 2,REMAINDER
DAC 0,@AVAIL
SETZM INVALID
LAC 1,BREAK
SUB 1,UNIVERSE
POPJ P,
DECLARE{BREAK}
ENDR COMPACT;2-MAY-73(TVR)
SUBR RELOCATE,OFFSET
DEFINE NXTNOD(AC,LIMIT)
< ADDI AC,NODSIZ
CAML AC,LIMIT
>
ACCUMULATORS{P1,NODE,HOLE,LOWER,UPPER,DELTA}
PTYPE←←HOLE
LAC UPPER,@BLKCNT ;CALCULATE ADDRESS OF BREAK
IMULI UPPER,NODSIZ
LAC NODE,UNIVERS
MOVEI LOWER,MINLINK(NODE)
LAC DELTA,OFFSET↔SUB LOWER,DELTA
LAC UPPER,44↔SUB UPPER,DELTA
ULOOP: LAC PTYPE,(NODE)
TLNE PTYPE,400400↔ZAC PTYPE, ;FRAME CHEAT
ANDI PTYPE,TYPMASK
HLLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HLLZ 0,YREL(NODE)
LSH 0,6
LACI P1,NODSIZ+MINLINK-1(NODE)
LLOOP: JUMPE 0,DORIGHT
JUMPL 0,[CAR 1,(P1)
CAML 1,LOWER
CAML 1,UPPER
GO .+1
ADD 1,DELTA
DIP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,LLOOP
DORIGH: HRLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HRLZ 0,YREL(NODE)
LSH 0,6
MOVEI P1,NODSIZ+MINLINK-1(NODE)
RLOOP: JUMPE 0,DONEXT
JUMPL 0,[CDR 1,(P1)
CAML 1,LOWER
CAML 1,UPPER
GO .+1
ADD 1,DELTA
DAP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,RLOOP
DONEXT: NXTNOD NODE,44
GO [ SETZM INVALID↔POP1J ]
GO ULOOP
ENDR RELOCATE;2-MAY-73(TVR)